Visual Basic Controls/Visual Basic Controls.iso/vbcontrol/addflo/data1.cab/Program_Executable_Files/AddFlow/Samples/Editor/main.frm

Visual Basic Form | 1997-05-06 | 16.3 KB | 557 lines

VERSION 4.00
Begin VB.Form Main
   Caption         =   "AddFlow Editor"
   ClientHeight    =   4635
   ClientLeft      =   1215
   ClientTop       =   1680
   ClientWidth     =   6225
   FillColor       =   &H0080FFFF&
   BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
      Name            =   "MS Sans Serif"
      Size            =   8.25
      Charset         =   0
      Weight          =   700
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   ForeColor       =   &H80000008&
   Height          =   5325
   Left            =   1155
   LinkTopic       =   "Form1"
   ScaleHeight     =   4635
   ScaleWidth      =   6225
   Top             =   1050
   Width           =   6345
   Begin VB.PictureBox StatusPicture
      Align           =   2  'Align Bottom
      Height          =   780
      Left            =   0
      ScaleHeight     =   720
      ScaleWidth      =   6165
      TabIndex        =   0
      Top             =   3855
      Width           =   6225
      Begin VB.TextBox TextTag
         Enabled         =   0   'False
         Height          =   555
         Left            =   570
         MultiLine       =   -1  'True
         ScrollBars      =   2  'Vertical
         TabIndex        =   4
         Top             =   90
         Width           =   1935
      End
      Begin VB.TextBox TextText
         Enabled         =   0   'False
         Height          =   555
         Left            =   3450
         MultiLine       =   -1  'True
         ScrollBars      =   2  'Vertical
         TabIndex        =   3
         Top             =   90
         Width           =   1935
      End
      Begin VB.Label Label1
         Caption         =   "Tag:"
         Height          =   255
         Left            =   90
         TabIndex        =   2
         Top             =   90
         Width           =   495
      End
      Begin VB.Label Label2
         Caption         =   "Text:"
         Height          =   255
         Left            =   2880
         TabIndex        =   1
         Top             =   120
         Width           =   555
      End
   End
   Begin AddFlowLib.AddFlow AddFlow1
      Height          =   3435
      Left            =   270
      TabIndex        =   5
      Top             =   330
      Width           =   4005
      _Version        =   65536
      _ExtentX        =   7064
      _ExtentY        =   6059
      _StockProps     =   101
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "Arial"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      BorderStyle     =   1
      ScrollBars      =   3
      Shape           =   0
      LinkStyle       =   0
      Alignment       =   7
      AutoSize        =   0
      ArrowDst        =   3
      ArrowOrg        =   0
      DrawStyle       =   0
      DrawWidth       =   1,4013e-45
      ReadOnly        =   0   'False
      MultiSel        =   -1  'True
      CanDrawNode     =   -1  'True
      CanDrawLink     =   -1  'True
      CanMoveNode     =   -1  'True
      CanSizeNode     =   -1  'True
      CanStretchLink  =   -1  'True
      CanMultiLink    =   -1  'True
      Transparent     =   0   'False
      ShowGrid        =   0   'False
      Hidden          =   0   'False
      Rigid           =   0   'False
      DisplayHandles  =   -1  'True
      AutoScroll      =   -1  'True
      xGrid           =   7,00649e-45
      yGrid           =   7,00649e-45
      xZoom           =   100
      yZoom           =   100
      FillColor       =   16777215
      DrawColor       =   0
      ForeColor       =   0
      BackPicture     =   "main.frx":0000
   End
   Begin MSComDlg.CommonDialog CMDialog1
      Left            =   4920
      Top             =   750
      _Version        =   65536
      _ExtentX        =   847
      _ExtentY        =   847
      _StockProps     =   0
   End
   Begin VB.Menu File
      Caption         =   "&File"
      Begin VB.Menu NewMenu
         Caption         =   "&New"
      End
      Begin VB.Menu OpenMenu
         Caption         =   "&Open..."
      End
      Begin VB.Menu SaveMenu
         Caption         =   "&Save"
      End
      Begin VB.Menu SaveAsMenu
         Caption         =   "Save &As..."
      End
      Begin VB.Menu SEPARATOR1
         Caption         =   "-"
      End
      Begin VB.Menu SaveAsMetafileMenu
         Caption         =   "Save As &Metafile..."
      End
      Begin VB.Menu SEPARATOR7
         Caption         =   "-"
      End
      Begin VB.Menu PrintFormMenu
         Caption         =   "&Print Form"
      End
      Begin VB.Menu SEPARATOR2
         Caption         =   "-"
      End
      Begin VB.Menu ExitMenu
         Caption         =   "&Exit"
      End
   End
   Begin VB.Menu EditMenu
      Caption         =   "&Edit"
      Begin VB.Menu CopyMenu
         Caption         =   "&Copy clipboard"
      End
      Begin VB.Menu DeleteSelectionMenu
         Caption         =   "&Delete Selection"
      End
      Begin VB.Menu DeleteMarkedMenu
         Caption         =   "Delete &Marked"
      End
      Begin VB.Menu SEPARATOR3
         Caption         =   "-"
      End
      Begin VB.Menu SelectAllMenu
         Caption         =   "Select &All"
      End
      Begin VB.Menu SEPARATOR4
         Caption         =   "-"
      End
      Begin VB.Menu SelectModeMenu
         Caption         =   "&Select Mode"
      End
      Begin VB.Menu SEPARATOR5
         Caption         =   "-"
      End
      Begin VB.Menu ZOrderMenu
         Caption         =   "&ZOrder"
         Begin VB.Menu ZOrderBackMenu
            Caption         =   "&Back"
            Enabled         =   0   'False
         End
         Begin VB.Menu ZOrderFrontMenu
            Caption         =   "&Front"
            Enabled         =   0   'False
         End
      End
      Begin VB.Menu SEPARATOR6
         Caption         =   "-"
      End
      Begin VB.Menu GroupMenu
         Caption         =   "&Group"
      End
      Begin VB.Menu UngroupMenu
         Caption         =   "&Ungroup"
      End
   End
   Begin VB.Menu ViewMenu
      Caption         =   "&View"
      Begin VB.Menu StatusBarMenu
         Caption         =   "&StatusBar"
         Checked         =   -1  'True
      End
   End
   Begin VB.Menu DrawMenu
      Caption         =   "&Draw"
      Begin VB.Menu PropertiesMenu
         Caption         =   "&Properties..."
      End
   End
   Begin VB.Menu HelpMenu
      Caption         =   "&?"
      Begin VB.Menu AboutMenu
         Caption         =   "&About..."
      End
   End
Attribute VB_Name = "Main"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
Const EXT_NET = "NET"
Const FILTER_NET = "Net Files(*.NET)|*.net|All Files(*.*)|*.*|"
Const EXT_WMF = "WMF"
Const FILTER_WMF = "Wmf Files(*.WMF)|*.wmf|All Files(*.*)|*.*|"
Dim Filename$
Dim wmfFileName$

Private Sub AboutMenu_Click()
  MsgBox "AddFlow Editor sample" + Chr(13) + "Copyright
 1997 Lassalle Technologies"
End Sub
Private Sub CopyMenu_Click()
  AddFlow1.SaveImage 1, 0, ""
  Set AddFlow1.SelectedNode = AddFlow1.PointedLink
End Sub
Private Sub DeleteMarkedMenu_Click()
  AddFlow1.DeleteMarked
End Sub
Private Sub DeleteSelectionMenu_Click()
  AddFlow1.DeleteSel
End Sub
Private Sub ExitMenu_Click()
  End
End Sub
Private Sub AddFlow1_DblClick()
  PropertiesMenu_Click
End Sub
Private Sub AddFlow1_KeyDown(KeyCode As Integer, Shift As Integer)
  Const KEY_DELETE = &H2E
  If KeyCode = KEY_DELETE Then
    DeleteSelectionMenu_Click
  End If
End Sub
Private Sub AddFlow1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  Dim area%
  ' If mouse down don't change the mouse pointer
  Const LEFT_BUTTON = 1
  If (Button And LEFT_BUTTON) > 0 Then
    Exit Sub
  End If
  With AddFlow1
    If .PointedNode Is Nothing And .PointedLink Is Nothing Then
      TextText.Text = ""
      TextTag.Text = ""
    ElseIf .PointedLink Is Nothing Then
      TextText.Text = .PointedNode.Text
      TextTag.Text = .PointedNode.Tag
    Else
      TextText.Text = .PointedLink.Text
      TextTag.Text = .PointedLink.Tag
    End If
    area = .PointedArea
    Select Case area
    Case 0
      .MousePointer = 8
    Case 1
      .MousePointer = 7
    Case 2
      .MousePointer = 6
    Case 3
      .MousePointer = 9
    Case 5
      .MousePointer = 10
    Case Else
      If .SelectMode = True Then
        .MousePointer = 2
      Else
        .MousePointer = 0
      End If
    End Select
  End With
End Sub
Private Sub AddFlow1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  If AddFlow1.SelectedNode Is Nothing And AddFlow1.SelectedLink Is Nothing Then
    ZOrderFrontMenu.Enabled = False
    ZOrderBackMenu.Enabled = False
  Else
    ZOrderFrontMenu.Enabled = True
    ZOrderBackMenu.Enabled = True
  End If
End Sub
Private Sub Form_Load()
  AddFlow1.Left = 0
  AddFlow1.Top = 0
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  QueryUnload (Cancel)
End Sub
Private Sub Form_Resize()
  If WindowState <> 1 And ScaleHeight <> 0 Then
    If StatusPicture.Visible Then
      AddFlow1.Height = ScaleHeight - StatusPicture.Height
      StatusPicture.Top = AddFlow1.Height
    Else
      AddFlow1.Height = ScaleHeight
    End If
    AddFlow1.Width = ScaleWidth
  End If
End Sub
Private Function GetFileName(Ext As String, Filter As String) As String
  Const OFN_OVERWRITEPROMPT = &H2&
  Const OFN_SHOWHELP = &H10&
  Const OFN_CREATEPROMPT = &H2000&
  'Display file open dialog
  CMDialog1.DefaultExt = "NET"
  CMDialog1.Filter = Filter
  CMDialog1.Flags = OFN_OVERWRITEPROMPT Or OFN_SHOWHELP Or OFN_CREATEPROMPT
  CMDialog1.Action = 1
  'Select a file and open it
  GetFileName = CMDialog1.Filename
End Function
Private Sub GroupMenu_Click()
  Dim LeftMin As Single, TopMin As Single
  Dim RightMax As Single, BottomMax As Single
  Dim nodx As afNode, owner As afNode, lnkx As afLink
  Dim First As Boolean
  With AddFlow1
    First = True
    For Each nodx In .Nodes
      If nodx.Selected Then
        If First = True Then
          First = False
          LeftMin = nodx.Left
          TopMin = nodx.Top
          RightMax = nodx.Left + nodx.Width
          BottomMax = nodx.Top + nodx.Height
        Else
          If nodx.Left < LeftMin Then LeftMin = nodx.Left
          If nodx.Top < TopMin Then TopMin = nodx.Top
          If nodx.Left + nodx.Width > RightMax Then
            RightMax = nodx.Left + nodx.Width
          End If
          If nodx.Top + nodx.Height > BottomMax Then
            BottomMax = nodx.Top + nodx.Height
          End If
        End If
      End If
    Next
    If Not First Then
      Set owner = .Nodes.Add(LeftMin, TopMin, RightMax - LeftMin, BottomMax - TopMin)
      owner.Hidden = True      'Invisible
      owner.Shape = afRectangle
      owner.Transparent = True 'Transparent
      For Each nodx In .Nodes
        If nodx.Selected Then
          Set lnkx = owner.OutLinks.Add(nodx)
          lnkx.Rigid = True
          lnkx.Hidden = True
          lnkx.Selectable = False
          nodx.Selectable = False
        End If
      Next
      Set .SelectedNode = owner
    End If
  End With
End Sub
Private Sub NewMenu_Click()
  Dim Cancel%
  Call QueryUnload(Cancel)
  If Cancel = False Then
    AddFlow1.Nodes.Clear
    AddFlow1.SetChangedFlag False
  End If
End Sub
Private Sub OpenMenu_Click()
  Dim Cancel%
  Call QueryUnload(Cancel)
  If Cancel = False Then
    Filename = GetFileName(EXT_NET, FILTER_NET)
    If Filename <> "" Then
      AddFlow1.Nodes.Clear
      MousePointer = 11
      OpenEasyNetFile AddFlow1, Filename
      MousePointer = 0
      AddFlow1.SetChangedFlag False
    End If
  End If
End Sub
Private Sub QueryUnload(Cancel As Integer)
  Dim Msg$, NL$, Response%
  If AddFlow1.IsChanged Then
    Cancel = False
    ' Message box
    NL = Chr$(10) & Chr$(13)
    If Filename <> "" Then
      Msg = "The diagram in [" & Filename & "] has changed."
      Msg = Msg & NL
    End If
    Msg = Msg & "Do you want to save the changes?"
    Response = MsgBox(Msg, 51, App.Title)
    Select Case Response
    ' Yes
    Case 6
      If Filename = "" Then
        'Get the filename to save the file
        Filename = GetFileName(EXT_NET, FILTER_NET)
        'If the user did not specify a file name,
        'cancel the unload; otherwise, save it.
        If Filename = "" Then
          Cancel = True
        Else
          SaveEasyNetFile AddFlow1, Filename
        End If
      Else
        SaveEasyNetFile AddFlow1, Filename
      End If
    ' No
    Case 7
    ' Cancel
    Case 2
      Cancel = True
    End Select
  End If
End Sub
Private Sub PrintFormMenu_Click()
  PrintForm
End Sub
Private Sub PropertiesMenu_Click()
  ItemProp.Show 1
End Sub
Private Sub SaveAsMenu_Click()
  Const OFN_OVERWRITEPROMPT = &H2&
  Const OFN_SHOWHELP = &H10&
  Const OFN_CREATEPROMPT = &H2000&
  'Display file save dialog
  CMDialog1.DefaultExt = EXT_NET
  CMDialog1.Filter = FILTER_NET
  CMDialog1.Flags = OFN_OVERWRITEPROMPT Or OFN_SHOWHELP Or OFN_CREATEPROMPT
  CMDialog1.Filename = Filename
  CMDialog1.DialogTitle = "Save As..."
  CMDialog1.Action = 2
  'Select a file
  Filename = CMDialog1.Filename
  If Filename <> "" Then
    MousePointer = 11
    SaveEasyNetFile AddFlow1, Filename
    MousePointer = 0
    AddFlow1.SetChangedFlag False
  End If
End Sub
Private Sub SaveAsMetafileMenu_Click()
  Const OFN_OVERWRITEPROMPT = &H2&
  Const OFN_SHOWHELP = &H10&
  Const OFN_CREATEPROMPT = &H2000&
  ' Display file save dialog
  With CMDialog1
    .DefaultExt = EXT_WMF
    .Filter = FILTER_WMF
    .Flags = OFN_OVERWRITEPROMPT Or OFN_SHOWHELP Or OFN_CREATEPROMPT
    .Filename = wmfFileName
    .DialogTitle = "Save As Metafile..."
    .Action = 2
  End With
  ' Select a file
  wmfFileName = CMDialog1.Filename
  If wmfFileName <> "" Then
    MousePointer = 11
    AddFlow1.SaveImage 0, 0, wmfFileName
    MousePointer = 0
  End If
End Sub
Private Sub SaveMenu_Click()
  If AddFlow1.IsChanged() = True Then
    If Len(Filename) <> 0 Then
      MousePointer = 11
      SaveEasyNetFile AddFlow1, Filename
      MousePointer = 0
      AddFlow1.SetChangedFlag False
    Else
      SaveAsMenu_Click
    End If
  End If
End Sub
Private Sub SelectAllMenu_Click()
  AddFlow1.SelectAll
End Sub
Private Sub SelectModeMenu_Click()
  AddFlow1.SelectMode = Not AddFlow1.SelectMode
  If AddFlow1.SelectMode = True Then
    SelectModeMenu.Checked = True
    AddFlow1.MousePointer = 2
  Else
    SelectModeMenu.Checked = False
    AddFlow1.MousePointer = 0
  End If
End Sub
Private Sub StatusBarMenu_Click()
  StatusPicture.Visible = Not StatusPicture.Visible
  StatusBarMenu.Checked = StatusPicture.Visible
  Form_Resize
End Sub
Private Sub UngroupMenu_Click()
  If AddFlow1.SelectedNode Is Nothing Then
    ' Nothing to do
  Else
    Dim lnkx As afLink
    For Each lnkx In AddFlow1.SelectedNode.OutLinks
      If lnkx.Selectable = False Then
        lnkx.Dst.Selectable = True
      End If
    Next
    AddFlow1.Nodes.Remove AddFlow1.SelectedNode
  End If
End Sub
Private Sub ZOrderBackMenu_Click()
  If AddFlow1.SelectedNode Is Nothing And AddFlow1.SelectedLink Is Nothing Then
    ' Nothing to do
  ElseIf AddFlow1.SelectedNode Is Nothing Then
    AddFlow1.SelectedLink.ZOrder = True
  Else
    AddFlow1.SelectedNode.ZOrder = True
  End If
End Sub
Private Sub ZOrderFrontMenu_Click()
  If AddFlow1.SelectedNode Is Nothing And AddFlow1.SelectedLink Is Nothing Then
    ' Nothing to do
  ElseIf AddFlow1.SelectedNode Is Nothing Then
    AddFlow1.SelectedLink.ZOrder = False
  Else
    AddFlow1.SelectedNode.ZOrder = False
  End If
End Sub